perm filename RESTP.F4[MSS,LCS] blob
sn#258330 filedate 1977-01-12 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE RESTP
C00005 ENDMK
Cā;
SUBROUTINE RESTP
COMMON /POSI/STFF(8),JJ2,JPQ /PX/KPN(1) /Q/Q(1)
COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
COMMON/XRN/RN(1) /XXX/LK,LP,JY /JN/J,N
1 /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
DIMENSION MM(1),NN(1),RX(50)
DATA IRST/0/
EQUIVALENCE (MX,RX,RN(2650)),(MM,RN),(NN,RN(501))
IF(IRST.EQ.0)GO TO 3
IF(NN(1).NE.2)GO TO 4
C NEXT IS A REST
IF(Q(MM(1)-3).LT.6)GO TO 4
C NEXT IS NUMBERED REST.
Q(MM(1)+5)=Q(MM(1)+5)+RX(10)
IRST=0
GO TO 3
4 MX=MX-1
CALL SHFTQ(RE)
C PUSHES DATA TO RIGHT A BIT
DO 9 K=KPN(JJ2-1),1,-1
9 Q(K+MX)=Q(K)
CC4 CALL RLOOP(Q(MX),Q,KPN(JJ2-1))
LX=RX(MX+2)
C THE WD CNT
CC MX=MX-1
RX(5)=ENDLN
10 CALL RLOOP(Q,RX(2),MX)
DO 5 K=N,1,-1
J=K+LX
NN(J)=NN(K)
MM(J)=MM(K)+MX
C SHIFT EVERYTHING
5 KPN(J)=KPN(K)+MX
N=N+LX
JJ2=JJ2+LX
KQ=KQ+MX
J=2
K=2
6 M=RX(K)+3
KPN(J)=KPN(J-1)+M
J=J+1
K=K+M
IF(K.LT.MX)GO TO 6
IRST=0
DO 7 K=1,LX
MM(K)=KPN(K)+3
C ASSUMES NO SLURS, HORIZ. LINES, ETC. AT THIS POINT.
7 NN(K)=CODEN(KPN,K,Q,J)
3 DO 1 K=N,1,-1
J=NN(K)
IF(J.GT.16)RETURN
IF(J.EQ.1)RETURN
IF(Q(MM(K)+1).GE.1000)RETURN
C NO RESTS COMBINED OVER DOUBLE BARS.
IF(J.NE.2)GO TO 1
M=MM(K)
IF(Q(M-3).LT.6)RETURN
IRST=-1
C NOW FOUND NUMBERED REST
IF(K.NE.1)GO TO 8
IRST=-2
C -2 = ONLY RESTS ON THIS LINE.
8 M=1
RE=ENDLN+3
DO 2 J=K,N
IF(NN(J).EQ.0)GO TO 2
C DO I NEED THIS??
JX=MM(J)
CC Q(JX)=Q(JX)-200
Q(JX)=RE
RE=RE+3
LX=Q(JX-3)+3
JX=JX-4
DO 2 JA=1,LX
M=M+1
2 RX(M)=Q(JA+JX)
MX=M
C WD CNT
JJ2=JJ2-N+K-1
RX(M+1)=N-K+1
N=K-1
IF(IRST.EQ.-2)N=-N
RETURN
1 CONTINUE
END